home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 13
/
Aminet 13 - August 1996.iso
/
MainActor
/
Rexx
/
LoadMPEG_adpro.ma
< prev
next >
Wrap
Text File
|
1996-07-09
|
9KB
|
373 lines
/* */
/* LoadMPEG_adpro.ma Alex Kazik 1994 */
/* LoadMPEG_HAM6.ma */
/* LoadMPEG_HAM8.ma Alle drei ARexx-Scripte sind zum laden von */
/* MPEG-Animationen. Das Script xxx_adpro konvertiert */
/* die Bilder mit hilfe von ADPro auf ein beliebiges */
/* Format, dir Dither und Palette Option wird unterstützt. Dir Scripte */
/* xxx_HAM* wandeln die Anim ohne ADPro in das HAM6/HAM8 format um. */
/* */
/* Alle verwendeten Programme zur decodiering der MPEG-Anims sowie der */
/* Konvertierung yuv2ppm und ppm2ilbm sind Public-Domain. */
/* */
/* */
/* please read the .doc for english infomation */
OPTIONS RESULTS
address MAINACTOR
printandstoretxt "ALX:MPEG Loader - by Alex Kazik 1994"
RequestFile "Select MPEG-File"
IF RC = 10 THEN
call xEXIT 1
mpgfile = RESULT
if ( exists(mpgfile) = 0 ) then
call xexit 6
RequestSaveFile "Select Dest-File"
IF RC = 10 THEN
call xEXIT 1
newname = RESULT
IF exists(newname) then do
printtxt "ALX:File already exists, replace?"
RequestSaveFile "Replace File -> select again!"
IF (RC = 10) | (RESULT ~= newname) then
call xexit 5
ADDRESS COMMAND 'delete' newname
end
printtxt "ALX:Decoding MPEG..."
ADDRESS COMMAND 'copy' mpgfile newname || '.mpg'
wbtofront
ADDRESS COMMAND 'MainActor:mpeg/mpeg -d' newname '>CON:'
screentofront
printtxt "ALX:Deleting TEMP."
ADDRESS COMMAND 'delete' newname || '.mpg'
pics=0
picname = newname || pics
if exists(picname || ".Y") = 0 then do
call xexit 2
end
if exists(picname || ".U") = 0 then do
call xexit 2
end
if exists(picname || ".V") = 0 then do
call xexit 2
end
pics=1
picname = newname || pics
if exists(picname || ".Y") = 0 then do
call xexit 7
end
if exists(picname || ".U") = 0 then do
call xexit 7
end
if exists(picname || ".V") = 0 then do
call xexit 7
end
xxx = 1
do while xxx = 1
pics = pics + 1
picname = newname || pics
if exists(picname || ".Y") = 0 then
xxx = 0
if exists(picname || ".U") = 0 then
xxx = 0
if exists(picname || ".V") = 0 then
xxx = 0
end
printandstoretxt "ALX:Could find" pics "Pictures."
RequestInteger 352 "Original picture-width of the MEPG"
IF RC = 10 THEN
call xEXIT
width=RESULT
RequestInteger 240 "Original picture-height of the MPEG"
IF RC = 10 THEN
call xEXIT 1
height=RESULT
DO i=1 to pics
yuvpic = i - 1
yuvname = newname || yuvpic
actualpic=newname || "." || Right("00000" || i, 5)
printtxt "ALX:Converting Pic" i || "/" || pics || ". (YUV -> PPM)"
ADDRESS COMMAND 'MainActor:mpeg/cyuv2ppm' yuvname 'T:ppm.TEMP' '-iw' width '-ih' height
printtxt "ALX:Converting Pic" i || "/" || pics || ". (PPM -> IFF)"
ADDRESS COMMAND 'MainActor:mpeg/ppmtoilbm >' || actualpic '-24FORCE' 'T:ppm.TEMP'
printtxt "ALX:Converting Pic" i || "/" || pics || ". (deleting TEMP)"
ADDRESS COMMAND 'delete' yuvname || ".?"
END
ADDRESS COMMAND 'delete t:ppm.TEMP'
IF ~SHOW('P','ADPro') THEN DO
PrintTXT "ALX:Invoking AdPro..."
ADDRESS COMMAND 'run >NIL: <NIL: adpro:adpro BEHIND MAXMEM=1000000'
ADDRESS COMMAND Wait 1
i = 1
j = 30
DO UNTIL (SHOW('P','ADPro')) | (i=0)
ADDRESS COMMAND Wait 1
PrintTXT "ALX:Invoking AdPro... (" || i || " sec)"
i = i + 1
if (i=j) then do
RequestInteger 0 "Who long I should sill wait? (until now " || i || 'sec | 0=Abb.)'
IF RC = 10 then
i = 0
ELSE DO
j = j + RESULT
if i = j then
i = 0
END
END
END
CloseADPro = 1
END
ELSE
CloseADPro = 0
NL = '0A'X
ADDRESS "ADPro"
ADPRO_TO_FRONT
TempDefaults = "T:TempADProDefaults"
SAVE_DEFAULTS TempDefaults
PSTATUS
oldPSTATUS = ADPRO_RESULT
LOAD_TYPE REPLACE
oldLoadType = ADPRO_RESULT
ORIENTATION PORTRAIT
oldLoadOrient = ADPRO_RESULT
LFORMAT "IFF"
oldLoader = ADPRO_RESULT
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
call xexit 3
END
SFORMAT "ANIM"
oldSaver = ADPRO_RESULT
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
call xexit 4
END
CALL GetColors
RENDER_TYPE colors
CALL GetPalette
if (palette = "Load") then do
GETFILE '"Select Palette"' "ADPRO:Colors"
IF (RC ~= 0) then
call xexit 1
palettename = ADPRO_RESULT
PLOAD palettename
palette="Locked"
end
if (palette = "Locked") then do
PSTATUS locked
cpf = "CPF=NO"
end
else do
PSTATUS UnLocked
cpf = "CPF=YES"
end
CALL GetDither
DITHER dithermode
ADDRESS MAINACTOR
screentofront
DO i=1 to pics
actualpic=newname || "." || Right("00000" || i, 5)
ADDRESS MAINACTOR
printtxt "ALX:Converting Pic" i || "/" || pics || ". (ADPro)"
ADDRESS "ADPro"
Load actualpic
Execute
Save newname "APPEND" "IMAGE"
ADDRESS MAINACTOR
printtxt "ALX:Converting Pic" i || "/" || pics || ". (deleting TEMP)"
ADDRESS COMMAND 'delete' actualpic
END
ADDRESS "ADPro"
Save newname "QUIT" "IMAGE"
ADDRESS MAINACTOR
GetSPName
if (rc = 0) then
OpenNewProject
SetSPLoader "ANIM" "IFF-Anim5"
LoadProject newname
CALL xEXIT 0
GetColors:
GetXX.1 = "2"
GetXX.2 = "4"
GetXX.3 = "8"
GetXX.4 = "16"
GetXX.5 = "32"
GetXX.6 = "64"
GetXX.7 = "128"
GetXX.8 = "256"
GetXX.9 = "EHB"
GetXX.10 = "HAM"
GetXX.11 = "HAM8"
GetXXMin = 1
GetXXMax = 11
GetXXDef = 8
CALL GetLV colors
PARSE VAR RESULT nr '"'colors'"' .
PARSE VAR colors colors .
if (nr = 0) then
call xexit 1
return
GetPalette:
ARG is
GetXX.1 = "Locked"
GetXX.2 = "UnLocked"
GetXX.3 = "Load PAL"
GetXXMin = 1
GetXXMax = 3
GetXXDef = 2
CALL GetLV "Palette"
PARSE VAR RESULT nr '"'palette'"' .
PARSE VAR palette palette .
if (nr = 0) then
call xexit 1
return
GetDither:
ARG is
GetXX.1 = "Off (0)"
GetXX.2 = "Floyd (1)"
GetXX.3 = "Burkes (2)"
GetXX.4 = "Sierra (3)"
GetXX.5 = "Jarvis (4)"
GetXX.6 = "Stucki (5)"
GetXX.7 = "Random (6)"
GetXX.8 = "Lg Ord (7)"
GetXX.9 = "Sm Ord (8)"
GetXXMin = 1
GetXXMax = 9
GetXXDef = 1
CALL GetLV "DITHER"
PARSE VAR RESULT dithermode '"'nr'"' .
if (dithermode = 0) then
call xexit 1
dithermode = dithermode - 1
IF (Dithermode = 6) | (Dithermode = 7) | (Dithermode = 8) THEN DO
continue = 0
ADDRESS "ADPro"
GETNUMBER '"Enter Dither Amount"' 16 1 256
DitherAmt = ADPRO_RESULT
IF (RC ~= 0) THEN
call xexit 1
DITHER_AMOUNT ditheramt
END
return
xexit:
ARG fehler
if (fehler = 0) then
fehler = "Done."
else if (fehler = 1) then
fehler = "Aborted!"
else if (fehler = 2) then
fehler = "Error while decoding."
else if (fehler = 3) then
fehler = "No IFF-Loader (ADPro)."
else if (fehler = 4) then
fehler = "No ANIM-Saver (ADPro)."
else if (fehler = 5) then
fehler = "File already exists."
else if (fehler = 6) then
fehler = "File don't exist."
else if (fehler = 7) then
fehler = "Anim must have min. 2 Pics."
IF SHOW('P','ADPro') THEN DO
address "ADPro"
adpro_to_front
if (fehler ~= "Done.") then
OKAY1 fehler
LFORMAT oldLoader
SFORMAT oldSaver
PSTATUS oldpstatus
LOAD_TYPE oldLoadType
ORIENTATION oldLoadOrient
IF (EXISTS( TempDefaults )) THEN DO
LOAD_DEFAULTS TempDefaults
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error restoring settings."
ADPRO_TO_BACK
END
ADDRESS COMMAND "Delete >NIL:" TempDefaults
END
if CloseADPro then do
OKAY2 "Should I quit ADPro?" || NL || NL || " OK - Yep" || NL || "CANCEL - NO."
IF RC ~= 0 then
ADPRO_EXIT
END
end
address MAINACTOR
Screentofront
PrintAndStoreTxt "ALX:" || fehler
exit
GetLV:
ARG GetXXTitle
GetXXReq = 0
String = '"' || GetXX.GetXXDef || '"'
DO LoopCounter = GetXXMin TO GetXXMax
String = String '"' || GetXX.LoopCounter || '"'
END
ADDRESS "ADPro"
ADPRO_TO_FRONT
continue = 0
DO UNTIL (continue = 1)
LISTVIEW GetXXTitle (GetXXMax-GetXXMin+1) ITEMS String
LISTVIEW_RC = RC
PARSE VAR ADPRO_RESULT '"'GetXXStr'"' scratch
GetXXRet = GetXXMin
DO WHILE (GetXXRet <= GetXXMax) & (COMPARE( GetXXStr, GetXX.GetXXRet ) ~= 0)
GetXXRet = GetXXRet + 1
END
IF ((LISTVIEW_RC ~= 0) & (LISTVIEW_RC ~= 1)) | (GetXXStr=" -----") THEN DO
OKAY2 "This value is requied." || NL || NL || " OK - Try it againl" || NL || "CANCEL - Abort."
IF (RC = 0) THEN do
GetXXRet=0
continue=1
end
END
ELSE
continue = 1
END
if (GetXXRet > GetXXMax) then
GetXXRet=0
Return GetXXRet '"' || GetXXStr || '"'